home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 / Ham Radio 2000.iso / ham2000 / bbs / reqzip / reqzip.pas < prev   
Pascal/Delphi Source File  |  1992-01-23  |  6KB  |  162 lines
  1. program reqzip;
  2.  
  3. {$M,2048,0,0}
  4. uses dos;
  5.  
  6. var
  7.    requ,messu,vastaus:text;
  8.    mrivi,rrivi,otsikko:string;
  9.    mailpath,vastpath:string[70];
  10.    kutsu:string[6];
  11.    f,laskuri:integer;
  12.    s:pathstr;
  13.  
  14. {--------Ohjelmassa ei ole pascalin ajatuksen vastaisesti proseduureja------}
  15. {--------Ajatus on se, että niin ohjelmasta tulisi mahdollisimman vähän-----}
  16. {--------muistia käyttävä T.S. proceduurimuuttujat jäävät pois--------------}
  17.  
  18. begin
  19.      if paramcount<>1 then halt;
  20.  
  21. {-----------------------------------------------------------------------------}
  22. {Luetaan init.srvstä oikeat polut käyttöön}
  23.  
  24.      assign(messu,'init.srv');
  25.      reset(messu);
  26.      laskuri:=0;
  27.      repeat
  28.            begin
  29.                 readln(messu,rrivi);
  30.                 if rrivi[1]<>'#' then inc(laskuri)
  31.            end;
  32.      until laskuri=6;
  33.  
  34.      if rrivi[length(rrivi)]<>'\' then rrivi:=rrivi+'\';
  35.      mailpath:=rrivi;
  36.  
  37.      repeat
  38.            begin
  39.                 readln(messu,rrivi);
  40.                 if rrivi[1]<>'#' then inc(laskuri)
  41.            end;
  42.      until laskuri=9;
  43.      if rrivi[length(rrivi)]<>'\' then rrivi:=rrivi+'\';
  44.      vastpath:=rrivi;
  45.      close(messu);
  46.  
  47. {-----------------------------------------------------------------------------}
  48. {Avataan requtiedosto ja haetaan halutut numerot, jotka ovat otsikkorivillä}
  49. {Otsikkorivi on tiedoston toinen rivi. Lähettäjän kutsu ekariviltä ! }
  50.  
  51.  
  52.          assign(requ,paramstr(1));
  53.          reset(requ);
  54.  
  55.  
  56.          readln(requ,rrivi);
  57.          f:=pos('<',rrivi)+1;
  58.          kutsu:='';
  59.          repeat
  60.                begin
  61.                     inc(f);
  62.                     if rrivi[f]<>' ' then kutsu:=kutsu+rrivi[f];
  63.                end;
  64.          until ((rrivi[f]=' ') or (f=length(rrivi)));
  65.          readln(requ,otsikko);
  66.          close(requ);
  67.  
  68.  
  69. {-----------------------------------------------------------------------------}
  70. {Alustetaan vastaus joka on REkutsu. Aletaan hakea viestejä numeron perusteella}
  71.  
  72.  
  73.          assign(vastaus,vastpath+'!-'+kutsu);
  74.          rewrite(vastaus);
  75.  
  76.          repeat
  77.                rrivi:='';
  78.                laskuri:=1;
  79.  
  80.                begin
  81. {---------------------tyhjät pois numeron edestä --------------------------}
  82.                     repeat
  83.                           if otsikko[laskuri]=' ' then inc(laskuri);
  84.                     until otsikko[laskuri]<>' ';
  85.  
  86.  
  87.  
  88. {--------------------otetaan numero spaceen asti---------------------------}
  89.                     repeat
  90.                           if otsikko[laskuri]<>' ' then
  91.                                                  begin
  92.                                                       rrivi:=rrivi+otsikko[laskuri];
  93.                                                       inc(laskuri);
  94.                                                  end;
  95.                     until ((otsikko[laskuri]=' ') or (laskuri=length(otsikko)+1));
  96.  
  97.  
  98.                     otsikko:=copy(otsikko,laskuri,length(otsikko)-laskuri+1);
  99.  
  100.  
  101. {--------------------jos saatiin joku messun numero-------------------------}
  102. {------------------lisätään etunollat ja haetaan file-----------------------}
  103.                     if rrivi<>'' then
  104.  
  105.                        begin
  106.                             if length(rrivi)<6 then
  107.                                                     for f:=1 to 6-length(rrivi) do
  108.                                                     rrivi:='0'+rrivi;
  109.  
  110.  
  111.                     s:=fsearch('M_'+rrivi+'.MES',mailpath+'mail'+rrivi[6]+'\');
  112.  
  113.                     if s='' then writeln(vastaus,'Viestiä ',rrivi,' ei löydy !')
  114.                             else
  115.                                  begin
  116.                                  assign(messu,fexpand(s));
  117.                                  reset(messu);
  118.                                  writeln(vastaus,'----- Viesti: #',rrivi,' ------');
  119.  
  120. {--------jos messu löytyi kopioidaan muut paitsi 'R:'-rivit vastaukseen----}
  121.                                  while not eof (messu) do
  122.  
  123.                                        begin
  124.                                             readln(messu,mrivi);
  125.                                             if copy(mrivi,1,2)<>'R:' then
  126.                                                               writeln(vastaus,mrivi);
  127.                                        end;
  128.  
  129.                                  writeln(vastaus,'----------------------------');
  130.                                  writeln(vastaus);
  131.                                  writeln(vastaus);
  132.                                  writeln(vastaus);
  133.  
  134.                                  close(messu);
  135.                                  end;
  136.                     end;
  137.                end;
  138.  
  139. {----kunnes koko otsikkorivi on skannattu läpi ---------------------------}
  140.          until otsikko='';
  141.          close(vastaus);
  142.  
  143. {----jos vanha zip löytyy, tuhotaan se ------------------------------------}
  144.          S:=fsearch('!-'+kutsu+'.zip',vastpath);
  145.          if s<>'' then
  146.                   begin
  147.                        assign(messu,fexpand(s));
  148.                        erase(messu);
  149.                   end;
  150.  
  151. {----pakataan vastaus ja tuhotaan pakkaamaton vastaus----------------------}
  152.          S:=fsearch('pkzip.exe',getenv('path'));
  153.          if s<>'' then
  154.                      begin
  155.                       swapvectors;
  156.                       exec(fexpand(s),'-m '+vastpath+'!-'+kutsu+' '+vastpath+'!-'+kutsu);
  157.                       swapvectors;
  158.                      end;
  159.  
  160.          erase(requ);
  161. end.
  162.